perm filename MAIL[NEW,LSP] blob sn#531337 filedate 1980-08-21 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Mail for Maclisp.   Derek Oppen 1978.
C00004 ENDMK
CāŠ—;
;;; Mail for Maclisp.   Derek Oppen 1978.

(DEFPROP MAIL
 (LAMBDA (L)
  (PROG (DEST MESSAGE)
        (COND 
		((NULL L) 
		        (PRINC (QUOTE |Destination?  (Any valid MAIL destination list surrounded by /"s)|))
			(TERPRI)
			(SETQ DEST (READ)))
		(T (SETQ DEST (EVAL(CAR L))) (SETQ L (CDR L))))
        (COND 
		((NULL L) 
			(PRINC (QUOTE |Message?  (surrounded by /"s)|)) 
			(TERPRI)
			(SETQ MESSAGE (READ)))
		(T (SETQ MESSAGE (EVAL(CAR L)))))
        (MAIL1 DEST MESSAGE)
        (TERPRI)
        (RETURN (QUOTE (Message sent to MAIL)))))
FEXPR)


(DEFUN MAIL1 (DEST MESSAGE)
	(APPLY 'UWRITE '(DSK (RMD SYS)))
	((lambda(↑r ↑w)
	  (PRINC '|MAIL//SUBJEC |)
	  (PRINC DEST)
	  (TERPRI)
	  (PRINC(ASCII(+ 6 6)))
	  (PRINC '|From |)
	  (PRINC (CADR (STATUS UNAME)))
	  (PRINC '| via maclsp|)
	  (TERPRI)
	  (TERPRI)
	  (PRINC MESSAGE)
	  (TERPRI)
	  (TERPRI)
	  (APPLY 'UFILE (LIST 
		  (IMPLODE(APPEND
			  (EXPLODE(CADR(STATUS UNAME)))
			  (CDDR(EXPLODE(GENSYM)))))
		   'FTP)))
	t t)
	(APPLY 'CRUNIT (LIST 'DSK (STATUS UDIR)))
	)